home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / IWPAS.ARC / SHOWEGA1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-12  |  4.4 KB  |  182 lines
  1. PROGRAM ShowEGA(input,output,picfile);
  2.  
  3. { Copyright (c) 1987, Ciarcia's Circuit Cellar          }
  4. {    All Rights Reserved                                }
  5.  
  6. { Version 1.01                  May 12, 1987            }
  7. {   Fixed SendEGA so it would work with more types      }
  8. {    of EGA boards.  kwd                                }
  9.  
  10. { shows image on EGA display using fixed "color" levels }
  11.  
  12. {$U- control-break checking during execution            }
  13. {$C- control-break checking during I/O operations       }
  14. {$R- array range checking                               }
  15.  
  16. {$Ideclares.p                   declarations            }
  17. {$Ihexutil.p                    hex utilities           }
  18. {$Iserial.p                     serial interface code   }
  19. {$Ipictures.p                   picture file code       }
  20. {$Iimages.p                     image processing        }
  21.  
  22. CONST
  23.  EGAint   = $10;                { EGA video services    }
  24.  graymax  = 9;                  { # gray shades - 1     }
  25.  
  26. TYPE
  27.  crng     = 0..graymax;         { gray scale index      }
  28.  cmaptype = ARRAY[bitrng] OF crng;
  29.  
  30. VAR
  31.  r        : regrec;
  32.  cmap     : cmaptype;
  33.  
  34. {--- Assign EGA colors                                  }
  35. {    histogram is available if needed...                }
  36.  
  37. PROCEDURE ShadeEGA(pic : picptr;
  38.                VAR cmap  : cmaptype);
  39.  
  40. VAR
  41.  bin        : bitrng;           { index into bins       }
  42.  
  43. BEGIN
  44.  
  45.  Writeln('Assigning colors');
  46.  
  47.  FOR bin := 0 TO maxbit DO BEGIN
  48.   CASE bin OF
  49.     0.. 3 : cmap[bin] := 0;
  50.     4.. 9 : cmap[bin] := 1;
  51.    10..16 : cmap[bin] := 2;
  52.    17..24 : cmap[bin] := 3;
  53.    25..31 : cmap[bin] := 4;
  54.    32..38 : cmap[bin] := 5;
  55.    39..46 : cmap[bin] := 6;
  56.    47..53 : cmap[bin] := 7;
  57.    54..59 : cmap[bin] := 8;
  58.    60..63 : cmap[bin] := 9;
  59.   END;
  60.  END;
  61.  
  62. END;
  63.  
  64.  
  65. {--- Show picture on EGA                                }
  66. {    two EGA pels are used for each image pel to        }
  67. {    improve aspect ratio and allow for gray dithering  }
  68.  
  69. PROCEDURE SendEGA(pic  : picptr;
  70.                   cmap : cmaptype);
  71.  
  72. VAR
  73.  r         : regrec;            { BIOS interface regs   }
  74.  row,col   : INTEGER;           { EGA coordinates       }
  75.  lndx      : linerng;           { line number           }
  76.  pndx      : pelrng;            { pel number            }
  77.  pelval1   : INTEGER;           { pel value left        }
  78.  pelval2   : INTEGER;           { pel value right       }
  79.  
  80. BEGIN
  81.  
  82.  r.AX := ($00 SHL 8) OR $10;    { 640 x 350 / 16 colors }
  83.  Intr(EGAint,r);
  84.  
  85.  row := 50;
  86.  FOR lndx := 0 TO maxline DO BEGIN
  87.   col := 64;
  88.   FOR pndx := 0 TO maxpel DO BEGIN
  89.    CASE cmap[pic^.fmt.lines[lndx].pels[pndx]] OF
  90.      0 : BEGIN
  91.           pelval1 := 0;
  92.           pelval2 := 0;
  93.          END;
  94.      1 : BEGIN
  95.           pelval1 := 0;
  96.           pelval2 := 8;
  97.          END;
  98.      2 : BEGIN
  99.           pelval1 := 8;
  100.           pelval2 := 8;
  101.          END;
  102.      3 : BEGIN
  103.           pelval1 := 8;
  104.           pelval2 := 7;
  105.          END;
  106.      4 : BEGIN
  107.           pelval1 := 0;
  108.           pelval2 := 7;
  109.          END;
  110.      5 : BEGIN
  111.           pelval1 := 7;
  112.           pelval2 := 7;
  113.          END;
  114.      6 : BEGIN
  115.           pelval1 := 0;
  116.           pelval2 := 15;
  117.          END;
  118.      7 : BEGIN
  119.           pelval1 := 8;
  120.           pelval2 := 15;
  121.          END;
  122.      8 : BEGIN
  123.           pelval1 := 7;
  124.           pelval2 := 15;
  125.          END;
  126.      9 : BEGIN
  127.           pelval1 := 15;
  128.           pelval2 := 15;
  129.          END;
  130.      ELSE BEGIN
  131.            pelval1 := 14;
  132.            pelval2 := 14;
  133.           END;
  134.    END;
  135.    r.AH := $0C;
  136.    r.AL := pelval1;
  137.    r.BX := $0000;
  138.    r.CX := col;
  139.    r.DX := row;
  140.    Intr(EGAint,r);
  141.    col := Succ(col);
  142.    r.AH := $0C;
  143.    r.AL := pelval2;
  144.    r.BX := $0000;
  145.    r.CX := col;
  146.    r.DX := row;
  147.    Intr(EGAint,r);
  148.    col := Succ(col);
  149.   END;
  150.   row := Succ(row);
  151.   IF KeyPressed
  152.    THEN BEGIN
  153.     TextMode;
  154.     HALT;
  155.    END;
  156.  END;
  157.  
  158. END;
  159.  
  160. {--- Main routine                                       }
  161.  
  162. BEGIN
  163.  
  164.  
  165.  pic1 := NIL;                   { ensure new alloc      }
  166.  PicSetup(pic1);                { set up picture array  }
  167.  
  168.  filespec := GetFSpec(ParamStr(1));
  169.  
  170.  LoadPicture(filespec,pic1);    { read picture          }
  171.  
  172.  ShadeEGA(pic1,cmap);           { determine color map   }
  173.  
  174.  SendEGA(pic1,cmap);            { send mapped picture   }
  175.  
  176.  GoToXY(1,24);
  177.  Writeln('Press Enter');
  178.  Readln;
  179.  TextMode;
  180.  
  181. END.
  182.